home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / w3 / w3-e19.el.z / w3-e19.el
Encoding:
Text File  |  1998-05-21  |  5.6 KB  |  160 lines
  1. ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3
  2. ;; Author: wmperry
  3. ;; Created: 1997/10/20 21:40:46
  4. ;; Version: 1.31
  5. ;; Keywords: faces, help, mouse, hypermedia
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
  9. ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
  10. ;;;
  11. ;;; This file is part of GNU Emacs.
  12. ;;;
  13. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  14. ;;; it under the terms of the GNU General Public License as published by
  15. ;;; the Free Software Foundation; either version 2, or (at your option)
  16. ;;; any later version.
  17. ;;;
  18. ;;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ;;; GNU General Public License for more details.
  22. ;;;
  23. ;;; You should have received a copy of the GNU General Public License
  24. ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;;; Boston, MA 02111-1307, USA.
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28.  
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. ;;; Enhancements For Emacs 19
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. (eval-when-compile
  33.   (require 'w3-props))
  34. (require 'w3-forms)
  35. (require 'font)
  36. (require 'w3-script)
  37.  
  38. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39. ;;; Help menu
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41. (defvar w3-e19-hotlist-menu nil "A menu for hotlists.")
  42. (defvar w3-e19-links-menu nil "A buffer-local menu for hyperlinks.")
  43. (defvar w3-e19-nav-menu nil "A buffer-local menu for html based <link> tags.")
  44. (defvar w3-e19-window-width nil)
  45.  
  46. (mapcar 'make-variable-buffer-local
  47.     '(w3-e19-hotlist-menu
  48.       w3-e19-window-width
  49.       w3-e19-links-menu
  50.       w3-e19-nav-menu))
  51.  
  52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53. ;;; Functions to build menus of urls
  54. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  55. (defun w3-e19-show-hotlist-menu ()
  56.   (interactive)
  57.   (let ((keymap (easy-menu-create-keymaps "Hotlist"
  58.                       (w3-menu-hotlist-constructor nil)))
  59.     (x nil)
  60.     (y nil))
  61.     (setq x (x-popup-menu t keymap)
  62.       y (and x (lookup-key keymap (apply 'vector x))))
  63.     (if (and x y)
  64.     (funcall y))))
  65.  
  66. (defun w3-e19-show-links-menu ()
  67.   (interactive)
  68.   (if (not w3-e19-links-menu)
  69.       (w3-build-FSF19-menu))
  70.   (let (x y)
  71.     (setq x (x-popup-menu t w3-e19-links-menu)
  72.       y (and x (lookup-key w3-e19-links-menu (apply 'vector x))))
  73.     (if (and x y)
  74.     (funcall y))))
  75.  
  76. (defun w3-e19-show-navigate-menu ()
  77.   (interactive)
  78.   (if (not w3-e19-nav-menu)
  79.       (w3-build-FSF19-menu))
  80.   (let (x y)
  81.     (setq x (x-popup-menu t w3-e19-nav-menu)
  82.       y (and x (lookup-key w3-e19-nav-menu (apply 'vector x))))
  83.     (if (and x y)
  84.     (funcall y))))
  85.  
  86. (defun w3-build-FSF19-menu ()
  87.   ;; Build emacs19 menus from w3-links-list
  88.   (let ((links (w3-menu-html-links-constructor nil))
  89.     (hlink (w3-menu-links-constructor nil)))
  90.     (setq w3-e19-nav-menu (easy-menu-create-keymaps "Navigate" links)
  91.       w3-e19-links-menu (easy-menu-create-keymaps "Links" hlink))))
  92.  
  93. (defun w3-setup-version-specifics ()
  94.   ;; Set up routine for emacs 19
  95.   (require 'lmenu) ; for popup-menu
  96.   )
  97.  
  98. (defun w3-store-in-clipboard (str)
  99.   "Store string STR in the system clipboard"
  100.   (cond
  101.    ((and (boundp 'interprogram-cut-function) interprogram-cut-function)
  102.     (funcall interprogram-cut-function str t))
  103.    (t
  104.     (case (device-type)
  105.       (x (x-select-text str))
  106.       (pm (pm-put-clipboard str))
  107.       (ns (ns-store-pasteboard-internal str))
  108.       (otherwise nil)))))
  109.  
  110. (defun w3-mode-version-specifics ()
  111.   ;; Emacs 19 specific stuff for w3-mode
  112.   (declare (special w3-face-index w3-display-background-properties))
  113.   (make-local-variable 'track-mouse)
  114.   (setq w3-e19-window-width (window-width))
  115.   (if w3-track-mouse (setq track-mouse t))
  116.   (if w3-display-background-properties
  117.       (let ((face (w3-make-face (intern
  118.                  (format "w3-style-face-%05d" w3-face-index))
  119.                 "An Emacs-W3 face... don't edit by hand." t))
  120.         (fore (car w3-display-background-properties))
  121.         (inhibit-read-only t)
  122.         (back (cdr w3-display-background-properties)))
  123.     (setq w3-face-index (1+ w3-face-index))
  124.     (if fore (font-set-face-foreground face fore))
  125.     (if back (font-set-face-background face back))
  126.     (fillin-text-property (point-min) (point-max) 'face 'face face))))
  127.  
  128. (defun w3-text-pixel-width (str &optional face)
  129.   "Return the pixel-width of a chunk of text STR with face FACE."
  130.   (* (length str) (frame-char-width)))
  131.  
  132. (defun w3-mouse-handler (e)
  133.   "Function to message the url under the mouse cursor"
  134.   (interactive "e")
  135.   (let* ((pt (posn-point (event-start e)))
  136.      (good (eq (posn-window (event-start e)) (selected-window)))
  137.      (mouse-events nil))
  138.     (if (not (and good pt (number-or-marker-p pt)))
  139.     nil
  140.       (widget-echo-help pt)
  141.       ;; FIXME!!! Need to handle onmouseover, on mouseout
  142.       (setq mouse-events (w3-script-find-event-handlers pt 'mouse))
  143.       (if (assq 'onmouseover mouse-events)
  144.       (w3-script-evaluate-form (cdr (assq 'onmouseover mouse-events)))))))
  145.  
  146. (defun w3-window-size-change-function (frame)
  147.   (let ((first (frame-first-window frame))
  148.     (cur nil))
  149.     (while (not (eq cur first))
  150.       (setq cur (if cur (next-window cur nil frame) first))
  151.       (save-excursion
  152.     (set-buffer (window-buffer cur))
  153.     (if (and (eq major-mode 'w3-mode)
  154.          (not (eq (window-width cur) w3-e19-window-width)))
  155.         (w3-refresh-buffer))))))
  156.  
  157.  
  158. (provide 'w3-emacs19)
  159. (provide 'w3-e19)
  160.